home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / GrafSys 2.0 / GrafSys 2.0 source / GrafSysObjectGeoB.p < prev    next >
Encoding:
Text File  |  1993-08-23  |  24.1 KB  |  622 lines  |  [TEXT/PJMM]
  1. unit GrafSysObject;
  2.  
  3. interface
  4. uses
  5.     Matrix, Transformations, OffscreenCore, GrafSysCore, GrafSysScreen;
  6.  
  7. const
  8.     MaxLine = 8000;
  9.  
  10. type
  11.  
  12.     LineEntry = record
  13.             fromP, toP: longint; (* max 8000 lines per model supported in this incarnation.  *)
  14.             hs, vs, he, ve: integer; (* for fast drawing. buffers transformed locations *)
  15.             newline: boolean; (* for optimization. if true, no MoveTo required *)
  16.             newLineColor: boolean;
  17.             LineColor: RGBColor;
  18.         end;
  19.  
  20.     LineBufPtr = ^LineBufRec;
  21.     LineBufRec = array[1..MaxLine] of LineEntry;
  22.  
  23.     TSObject3D = object(TSGenericObject3D)
  24.             Lines: LineBufPtr;
  25.             numLines: integer;
  26.             AutoErase: Boolean;
  27.             UseBounds: Boolean;
  28.             procedure Init;
  29.             override;
  30.             function Clone: TGenericObject;    {also clone line description buffer}
  31.             override;
  32.             procedure Reset;
  33.             override;
  34.             procedure Kill;
  35.             override;
  36.             function AddLine (fIndex, tIndex: longint): integer;        {add line to objects database. returns line index or -1}
  37.             function ChangeLine (LineIndex, fIndex, tIndex: longint): boolean;    {change line description of line with index }
  38.                                                                                     {lineIndex. True if successful                }
  39.             function ChangeLineColor (LineIndex: longint; theColor: RGBColor): boolean;
  40.                                                                         {change the color from this line on for all following }
  41.                                                                         {until the next ChangeColor command                      }
  42.             function GetLineColor (LineIndex: longint; var theColor: RGBColor; var ChangeHere: boolean): Boolean;
  43.                                                                         {returns the currently active color of specified line}
  44.             function KeepLineColor (LineIndex: longint): boolean;    {deletes change linecolor information. This line and }
  45.                                                                         {all following will have the same color as the pre-  }
  46.                                                                         {vious                                                      }
  47.             function DeleteLine (LineIndex: integer): Boolean;        {delete whole line from model. True on success}
  48.             function DeletePoint (index: longint): boolean;            {override inherited proc of this kind. This one checks}
  49.             override;                                                        {first if point is referenced to by a point. If so, it }
  50.                                                                         {returns false and doesn't delete the point            }
  51.             procedure GetLine (lineIndex: integer; var src, tgt: LongInt); {returns start and endpoint of line}
  52.             procedure BuildNewLines;    {should not be called from the outside}
  53.             procedure CollectLineData; {internal use only. fill the screen vals from point definition into line array}
  54.             procedure SetAutoerase (TurnOn: Boolean);                {controls setting of autoerase flag if switched on, }
  55.                                                                         {this procedure will initialize the oldBounds var    }
  56.             procedure SetUseBounds (TurnOn: Boolean);                {tells Draw and fDraw to collect bouding box data}
  57.             procedure Draw;                                            {recalcs if neccessary, erases old image if auto- }
  58.             override;                                                        {erase on, redraws all objects lines                     }
  59.             procedure fDraw;                                            {like Draw but it collects data prior to drawing }
  60.                                                                         {thus making the actual drawing process a bit  }
  61.                                                                         {faster but the whole call is slower than Draw }
  62.             procedure Erase;                                            {erase image of myself. this calcs and uses bounds}
  63.         end;
  64.  
  65. {Global Procedures for GrafSys}
  66. procedure InitGrafSys;
  67. procedure ArithmeticClip (var startV, endV: Point3DEntry; var skipThis, clippedThis: boolean; var sx, sy, ex, ey: integer);                                                                        {arithmetically clips a line that connects startV,endV }
  68.                                                                         {if it intersects the Z=0 plane. If it is completely behind }
  69.                                                                         {the Z=0 plane, skipThis is TRUE, if it intersects with }
  70.                                                                         {the plane, clippedThis becomes true and sx..ey contain}
  71.                                                                         {the new screen coordinates                                        }
  72.  
  73.  
  74. implementation
  75.  
  76. type
  77.     screenBuffer = array[1..MaxLine] of record
  78.             sx, sy: integer;
  79.             ex, ey: integer;
  80.             newLine: boolean;
  81.             newLineColor: boolean;
  82.             LineColor: RGBColor;
  83.         end;
  84.     screenBufPtr = ^screenBuffer;
  85.  
  86.  
  87. var
  88.     theBlack: RGBColor;
  89.     lineBuffer: screenBufPtr;
  90.     center: Point; (* screen center in local coords of current 3d grafport *)
  91.     thed: real;
  92.     screenBufNumLines: integer; (* number of lines in scren buffer *)
  93.  
  94. procedure InitGrafSys;
  95.     begin
  96.         InitMatrix; (* initialize the Matrix Package *)
  97.         lineBuffer := screenBufPtr(NewPtr(SIZEOF(screenBuffer)));
  98.         InitGrafSysScreen;
  99.         theBlack.red := 0;
  100.         theBlack.green := $0000;
  101.         theBlack.blue := 0;
  102.     end;
  103.  
  104. (* Clipping works the following way:  Eye orientation is looking in direction of positive z !!!!                               *)
  105. (*    - if both start and endpoint are behind the xy plane (have negative z-vals)  then the line is not shown at all. *)
  106. (*    - if both points have negative z-vals, the line is drawn entirely, no clipping required                                   *)
  107. (*    - otherwise the line is intersected with the xy plane and drawn from the point with positive z value to the  *)
  108. (*       intersection point                                                                                                                                    *)
  109.  
  110. (* new clipping algorithm :                                                                                                     *)
  111. (* first get start and endpoint                                                                                                 *)
  112. (* clipping only required if on opposite sides of the projection screen                                       *)
  113. (* if on opposite sides then we have to clip. the point to clip is always the endpoint of line, so   *)
  114. (*     we have to switch the two points if the endpoint is on the POSITIVE (=legal) side of plane  *)
  115.  
  116. (* the vars have the folloving meaning :                 *)
  117. (* s    : vector -- startpoint                                   *)
  118. (* e    : vector -- endpoint                                     *)
  119. (* dir : vector -- direction                                    *)
  120. (* t    : real -- parameter to calculate intersection *)
  121. (* d    : vector -- Intersection Point                       *)
  122.  
  123.  
  124. procedure ArithmeticClip (var startV, endV: Point3DEntry; var skipThis, clippedThis: boolean; var sx, sy, ex, ey: integer);
  125.  
  126.     type
  127.         realV = array[1..3] of real;
  128.  
  129.     var
  130.         xform, xform2: Matrix4;
  131.         thePoint, dir, d, dummyV: realV;
  132.         zbyd: Real;
  133.         lineCount: integer;
  134.         clipstart: boolean;
  135.         t: Real;
  136.         eyeSafetyDist: real;
  137.         s, e: realV;
  138.  
  139.     begin
  140.         skipThis := FALSE;
  141.         clippedthis := FALSE;
  142. {startV := theScrnObj^.Point[sp];}
  143. {endV := theScrnObj^.Point[ep];       (* now we have start & endpoint for clipping in 3D *)
  144.         GetVector4(startV.transformed, s[1], s[2], s[3]);
  145.         GetVector4(endV.transformed, e[1], e[2], e[3]);
  146.         if ((s[3] <= 0) and (e[3] <= 0)) or ((s[3] > 0) and (e[3] > 0)) then begin
  147.             if ((s[3] <= 0) and (e[3] <= 0)) then (* no line is drawn *)
  148.                 skipThis := TRUE
  149.             else begin (* whole line can be drawn, transfer it to the line buffer *)
  150.                 sx := startV.screenx; (* perspective xform has been applied already *)
  151.                 sy := startV.screeny;
  152.                 ex := endV.screenx;
  153.                 ey := endV.screeny;
  154.             end;
  155.         end
  156.         else (* we have to clip. will always clip endpoint *)
  157.             begin
  158.             clippedThis := TRUE;
  159.             if s[3] < 0 then (* we have to switch start and endpoint since endpoint is legal one *)
  160.                 begin
  161.                 dummyV := s;
  162.                 s := e;
  163.                 e := dummyV;
  164.                 sx := endV.screenx; (* these screen coords don't have to be *)
  165.                 sy := endV.screeny; (* recalculated *)
  166.             end
  167.             else begin
  168.                 sx := startV.screenX;
  169.                 sy := startV.screenY;
  170.             end; (* no switch *)
  171.  
  172.             dir[1] := e[1] - s[1]; (* now calc direction vector *)
  173.             dir[2] := e[2] - s[2];
  174.             dir[3] := e[3] - s[3];
  175.  
  176.             t := (0 - s[3]) / dir[3]; (* calc parameter for intersection *)
  177.             d[1] := s[1] + (t * dir[1]); (* calc intersection Point *)
  178.             d[2] := s[2] + (t * dir[2]);
  179.             d[3] := 0;
  180.  
  181. (* now we have to perspective-project the intersection point *)
  182.             if current3Dport^.projection = perspective then begin
  183.                 zbyd := 1 / (d[3] / thed + 1);
  184.                 ex := Trunc((d[1] * zbyd)) + center.h; (* do perspective transformation *)
  185.                 ey := -Trunc((d[2] * zbyd)) + center.v;
  186.             end
  187.             else begin
  188.                 ex := Trunc(d[1]) + center.h; (* do parallel projection *)
  189.                 ey := -Trunc(d[2]) + center.v;
  190.             end; (* parallel *)
  191.         end; (* else we have to clip *)
  192.  
  193.     end; (* arithmetic clip *)
  194.  
  195.  
  196.  
  197.  
  198. procedure TSObject3D.Init;
  199.     begin
  200.         inherited Init;
  201.         if ErrorCode <> noErr then
  202.             Exit(Init);
  203.         numLines := 0;
  204.         SetRect(Bounds, 0, 0, 0, 0);
  205.         oldBounds := Bounds;
  206.         AutoErase := False;
  207.         UseBounds := FALSE;
  208.         Lines := LineBufPtr(NewPtr(SIZEOF(LineBufRec)));
  209.         if Lines = nil then
  210.             ErrorCode := cOutOfMem;
  211.     end;
  212.  
  213. procedure TSObject3D.Reset;
  214.     override;
  215.     begin
  216.         inherited Reset;
  217.         AutoErase := FALSE;
  218.         UseBounds := False;
  219.     end;
  220.  
  221. {Clone: extend this procedure to also allocate a line buffer and copy all data from }
  222. {          the original                                                                        }
  223.  
  224. function TSObject3D.Clone: TGenericObject;
  225.     override;
  226.  
  227.     var
  228.         theClone: TSObject3D;
  229.  
  230.     begin
  231.         theClone := TSObject3D(inherited Clone);
  232.         theClone.Lines := LineBufPtr(NewPtr(SIZEOF(LineBufRec)));
  233.         if theClone.Lines = nil then
  234.             theClone.ErrorCode := cOutOfMem;
  235.         theClone.Lines^ := self.Lines^; (* copy the whole structure *)
  236.         Clone := theClone;
  237.     end;
  238.  
  239. procedure TSObject3D.Kill;
  240.     override;
  241.     begin
  242.         DisposPtr(Ptr(Lines));
  243.         inherited Kill;
  244.     end;
  245.  
  246. procedure TSObject3D.BuildNewLines;    {should not be called from the outside}
  247.     var
  248.         index: integer;
  249.  
  250.     begin
  251.         index := 2; (* check all lines starting with line two *)
  252.         while index <= numLines do begin
  253.             if Lines^[index].fromP = Lines^[index - 1].toP then
  254.                 Lines^[index].newLine := False
  255.             else
  256.                 Lines^[index].newline := TRUE;
  257.             index := index + 1;
  258.         end;
  259.         if numLines > 0 then
  260.             Lines^[1].newLine := TRUE; (* first line always true *)
  261.     end;
  262.  
  263. function TSObject3D.AddLine (fIndex, tIndex: longint): integer; {add line to objects database. returns line index or -1 }
  264.     begin
  265.         fIndex := fIndex - 1;
  266.         if (fIndex < 0) or (fIndex > numPoints) then begin
  267.             ErrorCode := cIllegalPointIndex;
  268.             AddLine := -1;
  269.             Exit(AddLine);
  270.         end;
  271.         tIndex := tIndex - 1; (* make f and t zero-based *)
  272.         if (tIndex < 0) or (tIndex > numPoints) then begin
  273.             ErrorCode := cIllegalPointIndex;
  274.             AddLine := -1;
  275.             Exit(AddLine);
  276.         end;
  277.  
  278.         if numLines < MaxLine then begin
  279.             numLines := numLines + 1;
  280.             Lines^[numLines].fromP := fIndex;
  281.             Lines^[numLines].toP := tIndex;
  282.             Lines^[numlines].newLineColor := FALSE;
  283.             if numLines > 1 then
  284.                 if Lines^[numLines].fromP = Lines^[numLines - 1].toP then
  285.                     Lines^[numLines].newLine := False
  286.                 else
  287.                     Lines^[numLines].newline := TRUE
  288.             else (* numLines = 1 *)
  289.                 Lines^[numLines].newline := TRUE;
  290.             AddLine := numLines;
  291.             objChanged := TRUE;
  292.         end
  293.         else begin
  294.             ErrorCode := cTooManyLines;
  295.             AddLine := -1;
  296.         end;
  297.     end;
  298.  
  299. function TSObject3D.ChangeLineColor (LineIndex: longint; theColor: RGBColor): boolean;
  300.                                                                         {change the color from this line on for all following }
  301.                                                                         {until the next ChangeColor command                      }
  302.     begin
  303.         if LineIndex <= numLines then begin
  304.             Lines^[LineIndex].newLineColor := TRUE;
  305.             Lines^[LineIndex].LineColor := theColor;
  306.             ChangeLineColor := TRUE;
  307.         end
  308.         else begin
  309.             ErrorCode := cIllegalLineIndex;
  310.             ChangeLineColor := FALSE;
  311.         end;
  312.     end;
  313.  
  314. function TSObject3D.GetLineColor (LineIndex: longint; var theColor: RGBColor; var ChangeHere: boolean): Boolean;
  315.                                                                         {returns the currently active color of specified line}
  316.     var
  317.         index: longint;
  318.  
  319.     begin
  320.         GetLineColor := TRUE;
  321.         theColor.red := 0;
  322.         theColor.green := 0;
  323.         theColor.blue := 0;
  324.         if LineIndex <= numLines then begin
  325.             index := 1;
  326.             while index <= LineIndex do (* walk down all lines and change line color if neccessary *)
  327.                 begin
  328.                 ChangeHere := Lines^[LineIndex].newLineColor;
  329.                 if ChangeHere then
  330.                     theColor := Lines^[LineIndex].LineColor;
  331.                 index := index + 1;
  332.             end;
  333.         end
  334.         else begin
  335.             ErrorCode := cIllegalLineIndex;
  336.             GetLineColor := FALSE;
  337.         end;
  338.     end;
  339.  
  340.  
  341. function TSObject3D.KeepLineColor (LineIndex: longint): boolean;
  342.                                                                         {deletes change linecolor information. This line and }
  343.                                                                         {all following will have the same color as the pre-  }
  344.                                                                         {vious                                                      }
  345.     begin
  346.         if LineIndex <= numLines then begin
  347.             Lines^[LineIndex].newLineColor := FALSE;
  348.             KeepLineColor := TRUE;
  349.         end
  350.         else begin
  351.             ErrorCode := cIllegalLineIndex;
  352.             KeepLineColor := FALSE;
  353.         end;
  354.     end;
  355.  
  356. function TSObject3D.ChangeLine (LineIndex, fIndex, tIndex: longint): boolean;    {change line description of line with index }
  357.                                                                                             {lineIndex. True if successful                }
  358.     begin
  359.         fIndex := fIndex - 1;
  360.         if (fIndex < 0) or (fIndex > numPoints) then begin
  361.             ErrorCode := cIllegalPointIndex;
  362.             ChangeLine := FALSE;
  363.             Exit(ChangeLine);
  364.         end;
  365.         tIndex := tIndex - 1; (* make f and t zero-based *)
  366.         if (tIndex < 0) or (tIndex > numPoints) then begin
  367.             ErrorCode := cIllegalPointIndex;
  368.             ChangeLine := FALSE;
  369.             Exit(ChangeLine);
  370.         end;
  371.  
  372.         if LineIndex <= numLines then begin
  373.             Lines^[LineIndex].fromP := fIndex;
  374.             Lines^[LineIndex].toP := tIndex;
  375.             if LineIndex > 1 then
  376.                 if Lines^[LineIndex].fromP = Lines^[LineIndex - 1].toP then
  377.                     Lines^[LineIndex].newLine := False
  378.                 else
  379.                     Lines^[LineIndex].newline := TRUE
  380.             else (* LineIndex = 1 *)
  381.                 Lines^[LineIndex].newline := TRUE;
  382.             ChangeLine := TRUE;
  383.             objChanged := TRUE;
  384.         end
  385.         else begin
  386.             ErrorCode := cIllegalLineIndex;
  387.             ChangeLine := FALSE;
  388.         end;
  389.     end;
  390.  
  391. function TSObject3D.DeleteLine (LineIndex: integer): Boolean;    {delete whole line from model. True on success}
  392.     var
  393.         index: integer;
  394.  
  395.     begin
  396.         if (LineIndex > numLines) or (LineIndex < 0) then begin
  397.             ErrorCode := cIllegalLineIndex;
  398.             DeleteLine := FALSE;
  399.             Exit(DeleteLine);
  400.         end;
  401. (* now move all line descs from above down once *)
  402.         index := lineIndex;
  403.         while index < numLines - 1 do begin
  404.             Lines^[index] := Lines^[index + 1];
  405.             index := index + 1;
  406.         end;
  407.  
  408. (* rebuild newline at the deleted spot *)
  409.         if LineIndex > 1 then
  410.             if Lines^[LineIndex].fromP = Lines^[LineIndex - 1].toP then
  411.                 Lines^[LineIndex].newLine := False
  412.             else
  413.                 Lines^[LineIndex].newline := TRUE
  414.         else (* LineIndex = 1 *)
  415.             Lines^[LineIndex].newline := TRUE;
  416.         numLines := numLines - 1;
  417.         objChanged := TRUE;
  418.         DeleteLine := TRUE;
  419.     end;
  420.  
  421. procedure TSObject3D.GetLine (lineIndex: integer; var src, tgt: LongInt); {returns start and endpoint of line or -1,-1}
  422.     begin
  423.         if (LineIndex > numLines) or (LineIndex < 0) then begin
  424.             ErrorCode := cIllegalLineIndex;
  425.             src := -1;
  426.             tgt := -1;
  427.             Exit(GetLine);
  428.         end;
  429.         src := Lines^[lineIndex].fromP + 1;
  430.         tgt := Lines^[lineIndex].toP + 1;
  431.     end;
  432.  
  433. function TSObject3D.DeletePoint (index: longint): boolean;    {override inherited proc of this kind. This one checks}
  434.     override;                                                            {first if point is referenced to by a point. If so, it }
  435.                                                                         {returns false and doesn't delete the point            }
  436.     var
  437.         hasRef: boolean;
  438.         lineIndex: integer;
  439.  
  440.     begin
  441. (* look if a point is referenced by any of the lines *)
  442.         hasRef := FALSE;
  443.         lineIndex := 1;
  444.         while not hasRef and (lineIndex <= numLines) do begin
  445.             if Lines^[lineIndex].fromP = index then
  446.                 hasRef := TRUE;
  447.             if Lines^[lineIndex].toP = index then
  448.                 hasRef := TRUE;
  449.             lineIndex := lineIndex + 1;
  450.         end;
  451.         if not hasRef then
  452.             DeletePoint := inherited DeletePoint(index)
  453.         else begin
  454.             ErrorCode := cCantDeletePoint;
  455.             DeletePoint := FALSE;
  456.         end;
  457.         objChanged := TRUE;
  458.         DeletePoint := TRUE;
  459.     end;
  460.  
  461.  
  462.  
  463. procedure TSObject3D.SetAutoerase (TurnOn: Boolean);
  464.     begin
  465.         Autoerase := TurnOn;
  466.         if AutoErase then
  467.             CalcBounds;
  468.     end;
  469.  
  470. procedure TSObject3D.SetUseBounds (TurnOn: Boolean);        {tells Draw and fDraw to collect bouding box data}
  471.     begin
  472.         UseBounds := TurnOn;
  473.     end;
  474.  
  475.  
  476. procedure TSObject3D.CollectLineData; {internal use only. fill the screen vals from point definition into line array}
  477.  
  478.     var
  479.         index: integer;
  480.         lBufIndex: integer; (* index to the line number in linebuf. always <= numLines *)
  481.         BufIndex, bufOffset: integer;
  482.         tempS, tempE: Point3DEntry;
  483.         clippedLast: Boolean; (* if this is true, the next line must have NewLine set to true *)
  484.         newLine: boolean;
  485.         skipThis: boolean;
  486.         ClipMode: ClippingType;
  487.         startx, starty, startz: real;
  488.         endx, endy, endz: real;
  489.         sx, sy, ex, ey: integer;
  490.         ClippedThis: Boolean;
  491.  
  492.     begin
  493.         index := 1;
  494.         lBufIndex := 1;
  495.         skipThis := FALSE;
  496.         ClipMode := current3DPort^.clipping;
  497.         clippedLast := FALSE;
  498.         center := current3DPort^.center;
  499.         thed := current3DPort^.d;
  500.         while index <= numLines do begin
  501.             newLine := Lines^[index].newLine or clippedLast;
  502.             GenIndex(Lines^[index].toP, BufIndex, bufOffset); (* this is executed anyways *)
  503.             tempE := theBufs[BufIndex]^[bufOffset]; (* read entry *)
  504.             GenIndex(Lines^[index].fromP, BufIndex, bufOffset);
  505.             tempS := theBufs[BufIndex]^[bufOffset]; (* read entry *)
  506.             LineBuffer^[lBufIndex].newLineColor := Lines^[index].newLineCo := temp.screeny;
  507.                         MoveTo(temp.screenx, temp.screeny);
  508.                     end;
  509.                     GenIndex(Lines^[index].toP, BufIndex, bufOffset);
  510.                     temp := theBufs[BufIndex]^[bufOffset]; (* read entry *)
  511.                     Lines^[index].he := temp.screenx;
  512.                     Lines^[index].ve := temp.screeny;
  513.                     LineTo(temp.screenx, temp.screeny);
  514.                 end;
  515.  
  516.                 arithmetic:  begin
  517.                     GenIndex(Lines^[index].fromP, BufIndex, bufOffset);
  518.                     tempS := theBufs[BufIndex]^[bufOffset]; (* read entry *)
  519.                     GenIndex(Lines^[index].toP, BufIndex, bufOffset);
  520.                     tempE := theBufs[BufIndex]^[bufOffset]; (* read entry *)
  521.                     ArithmeticClip(tempS, tempE, skipThis, clippedThis, sx, sy, ex, ey);
  522.                     if skipThis then
  523.                         skippedLast := TRUE
  524.                     else begin
  525.                         if clippedThis then (* do this only if point is drawn *)
  526.                             begin
  527.                             if ex < Bounds.left then     (* gather data for autoerase. only if clipped         *)
  528.                                 Bounds.left := ex - 1;    (* the point that needs to be checked is always     *)
  529.                             if ex > Bounds.right then    (* the endpoint (sx,sy)                            *)
  530.                                 Bounds.right := ex + 1;
  531.                             if ey < Bounds.top then
  532.                                 Bounds.top := ey - 1;
  533.                             if ey > Bounds.bottom then
  534.                                 Bounds.bottom := ey + 1;
  535.                         end;
  536.                         if needMoveTo or clippedThis then (* we need move to *)
  537.                             MoveTo(sx, sy);
  538.                         LineTo(ex, ey); (* draw it *)
  539.                         skippedLast := clippedThis; (* indicate we need a moveto *)
  540.                     end;
  541.                 end;
  542.  
  543.  
  544.                 fast: (* very simple clipping method : remove all lines that fall at least partwise off the screen *)
  545.                     begin
  546.                     GenIndex(Lines^[index].fromP, BufIndex, bufOffset);
  547.                     tempS := theBufs[BufIndex]^[bufOffset]; (* read entry *)
  548.                     GenIndex(Lines^[index].toP, BufIndex, bufOffset);
  549.                     tempE := theBufs[BufIndex]^[bufOffset]; (* read entry *)
  550.                     GetVector4(tempS.transformed, startx, starty, startz);
  551.                     GetVector4(tempE.transformed, endx, endy, endz);
  552.                     if (startz < 0) or (endz < 0) then begin
  553.                         skippedLast := TRUE; (* don't copy line *)
  554.                     end
  555.                     else begin (* draw line *)
  556.                         if needMoveTo then begin
  557.                         {Lines^[index].hs := tempS.screenx;}
  558.                         {Lines^[index].vs := tempS.screeny;}
  559.                             MoveTo(tempS.screenx, tempS.screeny);
  560.                         end;
  561.  
  562.                     {Lines^[index].he := tempE.screenx;}
  563.                     {Lines^[index].ve := tempE.screeny;}
  564.                         LineTo(tempE.screenx, tempE.screeny);
  565.                         skippedLast := FALSE;
  566.                     end;
  567.                 end;
  568.                 otherwise
  569.                     DebugStr('Unknown clipping method');
  570.             end; (* case *)
  571.  
  572. (* end of clipping *)
  573.  
  574.             index := index + 1;
  575.         end; (* while index *)
  576.         insetRect(Bounds, -1, -1);
  577.         hasChanged := FALSE;
  578.     end;
  579.  
  580.  
  581. procedure TSObject3D.fDraw;
  582.     override;
  583.     var
  584.         index: integer;
  585.  
  586.     begin
  587. (* first, set the current color to black *)
  588.         RGBForeColor(theBlack);
  589.         if Autoerase or useBounds then begin
  590.             Transform2(FALSE); (* calc transform (if neccessary), transfor and gather autoerase data as well *)
  591.                                 (* transform2 will move bounds -> oldBounds for ersure of old image *)
  592.         end
  593.         else
  594.             Transform(FALSE);
  595.  
  596.     (* now begin drawing all lines of the object *)
  597.  
  598.         CollectLineData; (* pre-gather all line-data for faster drawing. This includes clipping *)
  599.         index := 1;
  600.  
  601.         if AutoErase then
  602.             EraseRect(oldBounds); (* erase old image. Its rect was stored in oldBounds *)
  603.  
  604.         while index <= screenBufNumLines do begin
  605.             if LineBuffer^[index].newLineColor then (* first check the selected color *)
  606.                 RGBForeColor(LineBuffer^[index].LineColor);
  607.             if LineBuffer^[index].newLine then
  608.                 MoveTo(LineBuffer^[index].sx, LineBuffer^[index].sy);
  609.             LineTo(LineBuffer^[index].ex, LineBuffer^[index].ey);
  610.             index := index + 1;
  611.         end;
  612.  
  613.         hasChanged := FALSE;
  614.     end;
  615.  
  616. procedure TSObject3D.Erase;
  617.     begin
  618.         self.CalcBounds;
  619.         EraseRect(oldBounds);
  620.     end;
  621.  
  622. end.